Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/DropBin 1.5/DropBinAE.p

Text File | 1997-03-07 | 10.4 KB | 361 lines | [TEXT/CWIE]

Unit DropBinAE;

Interface

Uses
    Toolbox, DropBinUtils;

Const
    kErrStringID    = 100;
    kCantRunErr        = 1;
    kAEVTErr        = 2;

Function BinHexFile(vRef: integer; dirId: longint; name: str255): integer; external;

Procedure InitAEVTStuff;
Function GotRequiredParams(var theAppleEvent: AppleEvent): OSErr;
Function GetTargetFromSelf(var targetDesc: AEAddressDesc): OSErr;
Procedure _SendDocsToSelf(aliasList: AEDescList);
Procedure SendODOCToSelf(var theFileSpec: FSSpec);
Procedure SendQuitToSelf;
Function HandleOAPP(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;
Function HandleQuit (var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;
Function _HandleDocs (var theAppleEvent: AppleEvent; var reply: AppleEvent; opening: Boolean): OSErr;
Function HandleODOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;
Function HandlePDOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;
Procedure DoHighLevelEvent(event: EventRecord);


Implementation
{$NR+}

Procedure InitAEVTStuff;

Var
    aevtErr:    OSErr;

    begin
    aevtErr := noErr;
    aevtErr := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication,
                     @HandleOAPP, 0, false);
    if aevtErr = noErr then
        aevtErr := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments,
                    @HandleODOC, 0, false);
    if aevtErr = noErr then
        aevtErr := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments,
                    @HandlePDOC, 0, false);
    if aevtErr = noErr then
        aevtErr := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication,
                    @HandleQuit, 0, false);
    if aevtErr <> noErr then
        ;        { report an error }
    end;

Function GotRequiredParams(var theAppleEvent: AppleEvent): OSErr;

Var
    typeCode:        DescType;
    actualSize:        Size;
    retErr, err:    OSErr;

    begin
    err := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr,
                    typeWildCard, typeCode, NIL, 0, actualSize);
    if err = errAEDescNotFound then
        retErr := noErr
    else if err = noErr then
        retErr := errAEEventNotHandled
    else
        retErr := err;
    GotRequiredParams := retErr;
    end;

Function GetTargetFromSelf(var targetDesc: AEAddressDesc): OSErr;

Var
    psn:    ProcessSerialNumber;

    begin
    psn.highLongOfPSN := 0;
    psn.lowLongOfPSN := kCurrentProcess;
    GetTargetFromSelf := AECreateDesc(typeProcessSerialNumber, @psn,
        sizeof(ProcessSerialNumber), targetDesc);
    end;

Procedure _SendDocsToSelf(aliasList: AEDescList);

Var
    err:        OSErr;
    theTarget:    AEAddressDesc;
    openDocAE,
    replyAE:    AppleEvent;

    begin
{    First we create the target for the event.   We call another }
{    utility routine for creating the target. }
    err := GetTargetFromSelf(theTarget);
    if err = noErr then
        begin
        { Next we create the Apple event that will later get sent. }
        err := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, theTarget,
            kAutoGenerateReturnID, kAnyTransactionID, openDocAE);
        if err = noErr then
            begin
            { Now add the aliasDescList to the openDocAE }
            err := AEPutParamDesc(openDocAE, keyDirectObject, aliasList);
            if err = noErr then
                {    and finally send the event }
                {    Since we are sending to ourselves, no need for reply. }
                err := AESend(openDocAE, replyAE, kAENoReply + kAECanInteract,
                    kAENormalPriority, 3600, NIL, NIL);
                {    NOTE: Since we are not requesting a reply, we do not need to }
                {    need to dispose of the replyAE.  It is there simply as a  }
                {    placeholder. }
            {    Dispose of the aliasList descriptor }
            {    We do this instead of the caller since it needs to be done }
            {    before disposing the AEVT }
            err := AEDisposeDesc(aliasList);
            end;
        {    and of course dispose of the openDoc AEVT itself }
        err := AEDisposeDesc(openDocAE);
        end;
    end;

Procedure SendODOCToSelf(var theFileSpec: FSSpec);

Var
    err:        OSErr;
    aliasList:    AEDescList;
    aliasDesc:    AEDesc;
    aliasH:        AliasHandle;

    begin
    { Create the descList to hold the list of files }
    err := AECreateList(NIL, 0, false, aliasList);
    if err = noErr then
        begin
        { First we setup the type of descriptor }
        aliasDesc.descriptorType := typeAlias;
        {    Now we add the file to descList by creating an alias and then }
        {    adding it into the descList using AEPutDesc }
        err := NewAlias(NIL, theFileSpec, aliasH);
        aliasDesc.dataHandle := Handle(aliasH);
        err := AEPutDesc(aliasList, 0, aliasDesc);
        DisposeHandle(Handle(aliasH));
        { Now call the real gut level routine to do the dirty work }
        _SendDocsToSelf(aliasList);
        { _SendDocsToSelf will dispose of aliasList for me }
        end;
    end;

Procedure SendQuitToSelf;

Var
    err, foo:    OSErr;
    theTarget:    AEDesc;
    quitAE,
    replyAE:    AppleEvent;

    begin
    {    First we create the target for the event.   We call another }
    {    utility routine for creating the target. }
    err := GetTargetFromSelf(theTarget);
    if err = noErr then
        begin
        { Next we create the Apple event that will later get sent. }
        err := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, theTarget,
            kAutoGenerateReturnID, kAnyTransactionID, quitAE);
        if err = noErr then
            begin
            {    and finally send the event }
            {    Since we are sending to ourselves, no need for reply. }
            err := AESend(quitAE, replyAE, kAENoReply + kAECanInteract, kAENormalPriority,
                kAEDefaultTimeout, NIL, NIL);
            foo := AEDisposeDesc(quitAE);
            {    NOTE: Since we are not requesting a reply, we do not need to }
            {    need to dispose of the replyAE.  It is there simply as a  }
            {    placeholder. }
            end;
        foo := AEDisposeDesc(theTarget);
        end;
    end;

{    This routine is the handler for the oapp (Open Application) event.

    It first checks the number of parameters to make sure we got them all
    (even though we don't want any) and then calls the OpenApp userProc in QSUserProcs.
    Finally it checks to see if the caller wanted a reply & sends one, setting any error.
}
Function HandleOAPP(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;

Var
    err:    OSErr;
    data:    str255;

    begin
    err := GotRequiredParams(theAppleEvent);
    ErrorAlert(kErrStringID, kAEVTErr, err);
    if dbWindow <> nil then
        ShowWindow(dbWindow);
    gOApped := true;
    gState := true;
    if reply.dataHandle <> NIL then
        begin
        data := 'Opening';
        err := AEPutParamPtr(reply, 'errs', 'TEXT', @data, 7);
        ErrorAlert(kErrStringID, kAEVTErr, err);
        end;
    HandleOAPP := err;
    if handlerRefcon <> 0 then;
    end;

{    This routine is the handler for the quit (Quit Application) event.

    It first checks the number of parameters to make sure we got them all
    (even though we don't want any) and then calls the QuitApp userProc in QSUserProcs.
    Finally it checks to see if the caller wanted a reply & sends one, setting any error.
}
Function HandleQuit (var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;

Var
    err:    OSErr;
    data:    str255;

    begin
    err := GotRequiredParams(theAppleEvent);
    ErrorAlert(kErrStringID, kAEVTErr, err);
    gDone := true;
    if reply.dataHandle <> NIL then
        begin
        data := 'Quiting';
        err := AEPutParamPtr(reply, 'errs', 'TEXT', @data, 7);
        ErrorAlert(kErrStringID, kAEVTErr, err);
        end;
    HandleQuit := err;
    if handlerRefcon <> 0 then;
    end;

Procedure OpenDoc(var myFSS: FSSpec);

Var
    fileName:    Str255;
    oe:            integer;

    begin
    fileName := myFSS.name + '.hqx';
    oe := HCreate(myFSS.vRefNum, myFSS.parID, fileName, 'ttxt','TEXT');
    if (oe = paramErr) & (length(fileName) > 31) then
        begin
        DisplayMsg('Resulting file name "' + fileName + '" is too long... DropBin will '+
            'use "' + copy(fileName,1,27) + '.hqx" instead.');
        fileName := copy(fileName,1,27) + '.hqx';
        oe := HCreate(myFSS.vRefNum, myFSS.parID, fileName, 'ttxt','TEXT');
        end;
    if (oe <> noErr) and (oe <> dupFNErr) then
        begin
        AlertUser('Unable to create file "'+fileName+'"', oe);
        exit(OpenDoc);
        end;
    oe := HOpen(myFSS.vRefNum, myFSS.parID, fileName, fsRdWrPerm, gRefNum);
    if oe <> noErr then
        begin
        AlertUser('Unable to open "'+fileName+'"', oe);
        exit(OpenDoc);
        end;
    oe := SetEOF(gRefNum,0);
    if oe <> noErr then
        begin
        AlertUser('Unable to set EOF for "'+fileName+'"', oe);
        exit(OpenDoc);
        end;
    if oe = noErr then
        begin
        gOutputName := fileName;
        oe := BinHexFile(myFSS.vRefNum, myFSS.parID, myFSS.name);
        oe := FSClose(gRefNum);
        oe := FlushVol(nil,myFSS.vRefNum);
        end;
    end;

Function _HandleDocs (var theAppleEvent: AppleEvent; var reply: AppleEvent; opening: Boolean): OSErr;

Var
    err:            OSErr;
    myFSS:            FSSpec;
    docList:        AEDescList;
    index,
    itemsInList:    longint;
    actualSize:        Size;
    keywd:            AEKeyword;
    typeCode:        DescType;

    begin
    err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList);
    ErrorAlert(kErrStringID, kAEVTErr, err);
    err := GotRequiredParams(theAppleEvent);
    ErrorAlert(kErrStringID, kAEVTErr, err);
    if opening then
        begin
        {    How many items do we have? }
        err := AECountItems(docList, itemsInList);
        ErrorAlert(kErrStringID, kAEVTErr, err);
        for index := 1 to itemsInList do
            begin
            err := AEGetNthPtr(docList, index, typeFSS, keywd, typeCode,
                    @myFSS, sizeof(myFSS), actualSize);
            ErrorAlert(kErrStringID, kAEVTErr, err);
            OpenDoc(myFSS);
            end;
        if opening & (not gOApped) then
            gDone := true;
        end
    else
        err := errAEEventNotHandled;    { tells AEM that we didn't handle it!  }
    ErrorAlert(kErrStringID, kAEVTErr, AEDisposeDesc(docList));
    _HandleDocs := err;
    if reply.dataHandle <> NIL then;
    end;

{    This routine is the handler for the odoc (Open Document) event.

    The odoc event simply calls the common _HandleDocs routines, which will
    do the dirty work of parsing the AEVT & calling the userProcs.
}
Function HandleODOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;

    begin
    gState := true;
    HandleODOC := _HandleDocs(theAppleEvent, reply, true);    { call the low level routine }
    if handlerRefcon <> 0 then;
    end;

{    This routine is the handler for the pdoc (Print Document) event.

    The pdoc event like the odoc simply calls the common _HandleDocs routines
}
Function HandlePDOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                    handlerRefcon: longint): OSErr;

    begin
    HandlePDOC := _HandleDocs(theAppleEvent, reply, false);    { call the low level routine }
    if handlerRefcon <> 0 then;
    end;

{    This is the routine called by the main event loop, when a high level
    event is found.  Since we only deal with Apple events, and not other
    high level events, we just pass everything onto the AEM via AEProcessAppleEvent
}
Procedure DoHighLevelEvent(event: EventRecord);

    begin
    ErrorAlert(kErrStringID, kAEVTErr, AEProcessAppleEvent(event));
    end;

End.